<% '####################################### ' EDIT THESE LINES - INIZIO MODIFICA '####################################### '############ MySQL Server Settings ############ ' MySQL server IP address or Host Name (xxx.xxx.xxx.xxx/localhost) Dim MySQLSVR : MySQLSVR = "mysql53.secureserver.net" ' MySQL server port(default 3306) Dim MySQLPRT : MySQLPRT = 3306 ' MySQL server username Dim MySQLUID : MySQLUID = "freshbet" ' MySQL server password Dim MySQLPWD : MySQLPWD = "nordlac" ' MySQL server database name Dim MySQLDB : MySQLDB = "freshbet" ' MyODBC optional value Dim MySQLOPT : MySQLOPT = 16386 'Set up the database table name prefix ' This is useful if you are running multiple blog from one database Dim Table_Prefix : Table_Prefix = "" 'Set up the blog cookie and session name 'This is useful if you run multiple copies of Ublog Reload on the same site so that cookies don't interfer with each other Dim Cookie_Name : Cookie_Name = "UG" ' Blog URL: for example, "http://www.yourdomain.com/blog/" '*** remember final slash! *** Dim Ublog_address : Ublog_address = "http://www.freshbetbits.com/" ' general upload folder ( make sure that this folder have sufficient permissions to write ) Dim folder_upload : folder_upload = "public" ' virtual path of the images upload folder '*** remember final slash! *** Dim StrPathShortImage : StrPathShortImage = folder_upload & "/images_upload/" ' build image upload folder path '*** remember final slash! *** Dim Dir_Image_Upload : Dir_Image_Upload = "http://www.freshbetbits.com/public/images_upload/" ' virtual path of the files upload folder '*** remember final slash! *** Dim StrPathShortFile : StrPathShortFile = folder_upload & "/files_upload/" ' build file upload folder path '*** remember final slash! *** Dim Dir_File_Upload : Dir_File_Upload = "http://www.freshbetbits.com/public/files_upload/" ' kind of image file allowed to upload Dim imageuploadext : imageuploadext = "jpg,gif,bmp,png" ' max size allowed for each uploaded images Dim imageuploadsize : imageuploadsize = 100000 ' 100 kb -'50000 ' 50 kb ' kind of file allowed to upload Dim fileuploadext : fileuploadext = "doc,pdf,txt" ' max size allowed for each uploaded files Dim fileuploadsize : fileuploadsize = 100000 ' 100 kb ' virtual path of box folder Dim root_box_folder : root_box_folder = folder_upload & "/box" ' kind of file editable in File management Dim arrEditable : arrEditable = Array("html", "htm", "asp", "inc", "shtml", "txt", "php", "xml", "aspx", "pl", "vb", "cs", "js", "vbs", "css") ' number of pages per block Dim PagesPerBlock : PagesPerBlock = 10 '####################################### ' FINE MODIFICA - END OF EDIT '####################################### %> <% Dim timeStart, timeEnd timeStart = Timer() Dim adoCon Dim strCon Dim strSQL Dim rsconfiguration Dim Ublogname ' Ublog title Dim emailamministratore ' administrator email address Dim blnEmail ' verify if the notify via email to the administrator is activated Dim strEmailComponent ' Email Component Dim strSmtpServer ' SMTP Mail Server Dim intRecordsPerPage ' number of blogs per page Dim blnCookieSet ' anti-spam setting ( COOKIES ) Dim Time_difference ' if you're not on the timezone of your server Dim Ublogtype ' kind of weblog: "open" or "closed" Dim Ubloglanguage ' language chosen Dim maxchar ' max number of characters allowed for each message Dim blnLogin ' verify if the login is required for the publication of new blog in OPEN mode Dim blnUpImage ' verify if the images upload is allowed Dim blnUpFile ' verify if the files upload is allowed Dim blnSmile ' verify if the emoticon smilies are allowed Dim blntrack ' verify if the trackback is allowed Dim Ublog_background Dim Ublog_color1 Dim Ublog_color2 Dim Ublog_color3 Dim Ublog_font Dim Ublog_size Dim Ublog_font_colour Dim Ublog_layout Dim Ublog_Meta_Des Dim Ublog_Meta_Key Dim Ublog_Web_Refresh Dim UblogReloadVersion Dim UblogDate Dim UblogHour Dim Ublog_Email_Format Dim strLineBreak Dim UblogSMTPUsername Dim UblogSMTPPassword UblogReloadVersion = "Ublog Reload 1.0.5" Set adoCon = Server.CreateObject("ADODB.Connection") strCon = "Driver={MySQL ODBC 3.51 Driver};server="&MySQLSVR&";port="&MySQLPRT&";uid="&MySQLUID&";pwd="&MySQLPWD&";database="&MySQLDB&";option="&MySQLOPT&"" 'strCon = "Driver={MySQL};server="&MySQLSVR&";port="&MySQLPRT&";uid="&MySQLUID&";pwd="&MySQLPWD&";database="&MySQLDB&";option="&MySQLOPT&"" adoCon.Open strCon Set rsconfiguration = Server.CreateObject("ADODB.Recordset") strSQL = "SELECT * FROM " & Table_Prefix & "config;" rsconfiguration.CursorType = 3 rsconfiguration.Open strSQL, adoCon If NOT rsconfiguration.EOF Then Ublogname = rsconfiguration("nomeblog") Ublog_Meta_Des = rsconfiguration("meta_des") Ublog_Meta_Key = rsconfiguration("meta_key") emailamministratore = rsconfiguration("email_address") blnEmail = CBool(rsconfiguration("email_notify")) strEmailComponent = rsconfiguration("email_component") strSmtpServer = rsconfiguration("smtp_server") intRecordsPerPage = rsconfiguration("n_record") blnCookieSet = CBool(rsconfiguration("cookie")) Time_difference = rsconfiguration("timedifference")*3600 Ublogtype = rsconfiguration("tipologia") Ubloglanguage = rsconfiguration("language") maxchar = rsconfiguration("maxchar") blnLogin = CBool(rsconfiguration("login")) blnUpImage = CBool(rsconfiguration("up_image")) blnUpFile = CBool(rsconfiguration("up_file")) blnSmile = CBool(rsconfiguration("smile")) blntrack = CBool(rsconfiguration("track")) Ublog_background = rsconfiguration("background") Ublog_color1 = rsconfiguration("colour_base1") Ublog_color2 = rsconfiguration("colour_base2") Ublog_color3 = rsconfiguration("colour_base3") Ublog_font = rsconfiguration("font") Ublog_size = rsconfiguration("size") Ublog_font_colour = rsconfiguration("font_colour") Ublog_Web_Refresh = rsconfiguration("refreshweb") UblogDate = rsconfiguration("dateformat") UblogHour = rsconfiguration("hourformat") Ublog_layout = rsconfiguration("layout") Ublog_Email_Format = rsconfiguration("emailformat") UblogSMTPUsername = rsconfiguration("smtp_server_user") UblogSMTPPassword = rsconfiguration("smtp_server_pass") End If rsconfiguration.Close Set rsconfiguration = Nothing If Ublog_Email_Format = "HTML" Then strLineBreak = "
" Else strLineBreak = VbCrLf End If 'Load the language data Execute(GetFileContents(Server.MapPath("language/" & Ubloglanguage & ".inc"))) Dim bLoggedIn bLoggedIn = (Len(Session(Cookie_Name & "UblogUsername")) > 0) 'Attempt to retrieve the login data from cookies If Not bLoggedIn Then Session(Cookie_Name & "UblogUsername") = Decrypt(Request.Cookies(Cookie_Name & "UblogR")("Username")) Session(Cookie_Name & "UblogEmail") = Decrypt(Request.Cookies(Cookie_Name & "UblogR")("Email")) Session(Cookie_Name & "UblogLevel") = Decrypt(Request.Cookies(Cookie_Name & "UblogR")("Level")) bLoggedIn = (Len(Session(Cookie_Name & "UblogUsername")) > 0) End If %> <% '****************************************** '*** Cookies & password Encryption ***** '****************************************** Const ENCKEY = "UblogReload1.0.4" Function Encrypt(Stringa) Encrypt = Binary2StringaHex(EncryptStringa(Stringa, ENCKEY)) End Function Function Decrypt(Stringa) Decrypt = Trim(EncryptStringa(StringaHex2Binary(Stringa), ENCKEY)) End Function Function EncryptStringa(Stringa, Chiave) lChiave = 0 For p = 1 to Len(Chiave) lChiave = lChiave + Asc(Mid(Chiave,p,1)) Next Rnd (-1 * lChiave) Buffer = "" For p = 1 To Len(Stringa) c = Asc(Mid(Stringa, p, 1)) - 32 c1 = (c Xor (Int(Rnd() * 64))) + 32 Buffer = Buffer & Chr(c1) Next EncryptStringa = Buffer End Function Function Binary2StringaHex(Stringa) Buffer = "" For k = 1 To Len(Stringa) Buffer = Buffer + HexValue(Asc(Mid(Stringa, k, 1)), 2) Next Binary2StringaHex = Buffer End Function Function HexValue(valore, Cifre) HexValue = Right(String(Cifre, "0") + Hex(valore), Cifre) End Function Function StringaHex2Binary(Stringa) Buffer = "" For k = 1 To Len(Stringa) Step 2 HexVal = "&H" + Mid(Stringa, k, 2) Buffer = Buffer + Chr(cint(HexVal)) Next StringaHex2Binary = Buffer End Function Function IIf(bCheck, sTrue, sFalse) If bCheck Then IIf = sTrue Else IIf = sFalse End Function Function GetFileContents(FilePath) Dim FSO Set FSO = Server.CreateObject("Scripting.FileSystemObject") If FSO.FileExists(FilePath) Then GetFileContents = FSO.OpenTextFile(FilePath, 1).ReadAll Else GetFileContents = Null End If End Function 'Check a variable isn't "empty" Function IsBlank(byref TempVar) 'by default, assume it's not blank IsBlank = False 'now check by variable type select case VarType(TempVar) 'Empty & Null case 0, 1 IsBlank = True 'String case 8 if Len(TempVar) = 0 then IsBlank = True end if 'Object case 9 tmpType = TypeName(TempVar) If (tmpType = "Nothing") Or (tmpType = "Empty") Then IsBlank = True End If 'Array case 8192, 8204, 8209 'does it have at least one element? if UBound(TempVar) = -1 then IsBlank = True end if end select end function '****************************************** %> <% '***************************** '*** Category Function ***** '***************************** Private Function ListCat(strID, strIndents, strFormat) Dim rs_cat_parent Dim strIndentString If strFormat = "AdminList" Or strFormat = "CategoryViewList" Then strSQL = "SELECT " & Table_Prefix & "category.cat_id,cat_name,cat_parent,cat_des,COUNT(" & Table_Prefix & "blog.blog_id) "_ & "AS cat_count FROM " & Table_Prefix & "category LEFT JOIN " & Table_Prefix & "blog2cat ON (" & Table_Prefix & "category.cat_id = " & Table_Prefix & "blog2cat.cat_id) "_ & "LEFT JOIN " & Table_Prefix & "blog ON (" & Table_Prefix & "blog.blog_id = " & Table_Prefix & "blog2cat.blog_id) WHERE cat_parent = " & strID & " " _ & "GROUP BY " & Table_Prefix & "category.cat_id,cat_name,cat_parent,cat_des ORDER BY cat_name;" Else strSQL = "SELECT cat_id,cat_name,cat_parent FROM " & Table_Prefix & "category WHERE cat_parent = " & strID & " ORDER BY cat_name;" End If Set rs_cat_parent = adoCon.Execute(strSQL) Do Until rs_cat_parent.EOF If strFormat = "CategoryViewList" Then strIndentSubString = "    " strIndentString = strIndentSubString For count = 1 To strIndents strIndentString = strIndentString & strIndentSubString Next Else strIndentSubString = "— " strIndentString = strIndentSubString For count = 1 To strIndents strIndentString = strIndentString & strIndentSubString Next End If If strFormat = "AdminList" Then Response.Write VbCrLf & "" Response.Write VbCrLf & "" & strIndentString & ValidateHTML(rs_cat_parent("cat_name")) & "" Response.Write VbCrLf & "" If rs_cat_parent("cat_des") <> "" Then Response.Write ValidateHTML(rs_cat_parent("cat_des")) Response.Write VbCrLf & "" Response.Write VbCrLf & "" & rs_cat_parent("cat_count") & "" Response.Write VbCrLf & "" & strLangFormEditCat & "" Response.Write VbCrLf & "" & strLangFormDeleteCat & "" Response.Write VbCrLf & "" ElseIf strFormat = "CategoryViewList" Then Response.Write VbCrLf & "
" If ci = rs_cat_parent("cat_id") And rs_cat_parent("cat_count") <> 0 Then Response.Write strIndentString & "" & ValidateHTML(rs_cat_parent("cat_name")) & " [ " & rs_cat_parent("cat_count") & " ]" ElseIf rs_cat_parent("cat_count") = 0 Then Response.Write strIndentString & ValidateHTML(rs_cat_parent("cat_name")) & " [ " & rs_cat_parent("cat_count") & " ]" Else Response.Write strIndentString & " "" Then Response.Write ValidateHTML(rs_cat_parent("cat_des")) Else Response.Write strLangALTCategoryListView & ValidateHTML(rs_cat_parent("cat_name")) End If Response.Write """>" & ValidateHTML(rs_cat_parent("cat_name")) & " [ " & rs_cat_parent("cat_count") & " ]" End If Response.Write "RSS ATOM" Response.Write VbCrLf & "
" ElseIf strFormat = "DropDownListAdd" Then Response.Write VbCrLf & "" ElseIf strFormat = "DropDownListEdit" Then If rs_cat_parent("cat_id") <> cat_id And rs_cat_parent("cat_parent") <> cat_id Then Response.Write VbCrLf & "" End If ElseIf strFormat = "DropDownEditBlogList" Then blncatcheck = False For iCount = 0 To UBound(ArrCat, 2) If blncatcheck = True Then Exit For If CInt(ArrCat(0, iCount)) = rs_cat_parent("cat_id") Then bcatchecked = " selected=""selected""" blncatcheck = True Else bcatchecked = "" blncatcheck = False End If Next Response.Write VbCrLf & "" End If ListCat rs_cat_parent("cat_id"), strIndents + 1, strFormat rs_cat_parent.MoveNext Loop rs_cat_parent.Close : Set rs_cat_parent = Nothing End Function '***************************** %> <% '******************************************************************************************** '*** UBBcode - Bad words - Long Words - Highlight text - Text Preview - Emoticons ****** '******************************************************************************************** Function UBBcode(ByVal strMessage) Dim strTempMessageLink Dim strMessageLink Dim lngLinkStartPos Dim lngLinkEndPos strMessage = Replace(strMessage, "[b]", "", 1, -1, 1) strMessage = Replace(strMessage, "[/b]", "", 1, -1, 1) strMessage = Replace(strMessage, "[i]", "", 1, -1, 1) strMessage = Replace(strMessage, "[/i]", "", 1, -1, 1) strMessage = Replace(strMessage, "[u]", "", 1, -1, 1) strMessage = Replace(strMessage, "[/u]", "", 1, -1, 1) strMessage = Replace(strMessage, "[list=]", "
    ", 1, -1, 1) strMessage = Replace(strMessage, "[/list=]", "
", 1, -1, 1) strMessage = Replace(strMessage, "[list]", "", 1, -1, 1) strMessage = Replace(strMessage, "[li]", "
  • ", 1, -1, 1) strMessage = Replace(strMessage, "[/li]", "
  • ", 1, -1, 1) strMessage = Replace(strMessage, "[center]", "
    ", 1, -1, 1) strMessage = Replace(strMessage, "[/center]", "
    ", 1, -1, 1) strMessage = Replace(strMessage, "[blockquote]", "
    ", 1, -1, 1) strMessage = Replace(strMessage, "[/blockquote]", "
    ", 1, -1, 1) Do While InStr(1, strMessage, "[color=", 1) > 0 AND InStr(1, strMessage, "[/color]", 1) > 0 lngLinkStartPos = InStr(1, strMessage, "[color=", 1) lngLinkEndPos = InStr(lngLinkStartPos, strMessage, "[/color]", 1) + 8 If lngLinkEndPos - lngLinkStartPos =< 7 Then lngLinkEndPos = lngLinkStartPos + 7 strMessageLink = Trim(Mid(strMessage, lngLinkStartPos, (lngLinkEndPos - lngLinkStartPos))) strTempMessageLink = strMessageLink strTempMessageLink = Replace(strTempMessageLink, "[color=", "", 1, -1, 1) strTempMessageLink = Replace(strTempMessageLink, "]", """>", 1, -1, 1) strMessage = Replace(strMessage, strMessageLink, strTempMessageLink, 1, -1, 1) Loop Do While InStr(1, strMessage, "[size=", 1) > 0 AND InStr(1, strMessage, "[/size]", 1) > 0 lngLinkStartPos = InStr(1, strMessage, "[size=", 1) lngLinkEndPos = InStr(lngLinkStartPos, strMessage, "[/size]", 1) + 7 If lngLinkEndPos - lngLinkStartPos =< 6 Then lngLinkEndPos = lngLinkStartPos + 6 strMessageLink = Trim(Mid(strMessage, lngLinkStartPos, (lngLinkEndPos - lngLinkStartPos))) strTempMessageLink = strMessageLink strTempMessageLink = Replace(strTempMessageLink, "[size=", "", 1, -1, 1) strTempMessageLink = Replace(strTempMessageLink, "]", """>", 1, -1, 1) strMessage = Replace(strMessage, strMessageLink, strTempMessageLink, 1, -1, 1) Loop Do While InStr(1, strMessage, "[img]", 1) > 0 AND InStr(1, strMessage, "[/img]", 1) > 0 lngLinkStartPos = InStr(1, strMessage, "[img]", 1) lngLinkEndPos = InStr(lngLinkStartPos, strMessage, "[/img]", 1) + 6 strMessageLink = Trim(Mid(strMessage, lngLinkStartPos, (lngLinkEndPos - lngLinkStartPos))) strTempMessageLink = strMessageLink strTempMessageLink = Replace(strTempMessageLink, "[img]", "", 1, -1, 1) strMessage = Replace(strMessage, strMessageLink, strTempMessageLink, 1, -1, 1) Loop Do While InStr(1, strMessage, "[url=", 1) > 0 AND InStr(1, strMessage, "[/url]", 1) > 0 lngLinkStartPos = InStr(1, strMessage, "[url=", 1) lngLinkEndPos = InStr(lngLinkStartPos, strMessage, "[/url]", 1) + 6 If lngLinkEndPos - lngLinkStartPos =< 5 Then lngLinkEndPos = lngLinkStartPos + 5 strMessageLink = Trim(Mid(strMessage, lngLinkStartPos, (lngLinkEndPos - lngLinkStartPos))) strTempMessageLink = strMessageLink strTempMessageLink = Replace(strTempMessageLink, "[url=", "", 1, -1, 1) strTempMessageLink = Replace(strTempMessageLink, "]", """ target=""_blank"">", 1, -1, 1) strMessage = Replace(strMessage, strMessageLink, strTempMessageLink, 1, -1, 1) Loop Do While InStr(1, strMessage, "[email=", 1) > 0 AND InStr(1, strMessage, "[/email]", 1) > 0 lngLinkStartPos = InStr(1, strMessage, "[email=", 1) lngLinkEndPos = InStr(lngLinkStartPos, strMessage, "[/email]", 1) + 8 If lngLinkEndPos - lngLinkStartPos =< 7 Then lngLinkEndPos = lngLinkStartPos + 7 strMessageLink = Trim(Mid(strMessage, lngLinkStartPos, (lngLinkEndPos - lngLinkStartPos))) strTempMessageLink = strMessageLink strTempMessageLink = Replace(strTempMessageLink, "[email=", "", 1, -1, 1) strTempMessageLink = Replace(strTempMessageLink, "]", """>", 1, -1, 1) strMessage = Replace(strMessage, strMessageLink, strTempMessageLink, 1, -1, 1) Loop Do While InStr(1, strMessage, "[file=", 1) > 0 AND InStr(1, strMessage, "[/file]", 1) > 0 lngLinkStartPos = InStr(1, strMessage, "[file=", 1) lngLinkEndPos = InStr(lngLinkStartPos, strMessage, "[/file]", 1) + 7 If lngLinkEndPos - lngLinkStartPos =< 6 Then lngLinkEndPos = lngLinkStartPos + 6 strMessageLink = Trim(Mid(strMessage, lngLinkStartPos, (lngLinkEndPos - lngLinkStartPos))) strTempMessageLink = strMessageLink strTempMessageLink = Replace(strTempMessageLink, "[file=", "", 1, -1, 1) strTempMessageLink = Replace(strTempMessageLink, "]", """>", 1, -1, 1) strMessage = Replace(strMessage, strMessageLink, strTempMessageLink, 1, -1, 1) Loop UBBcode = strMessage End Function Function BadWords(ByVal strMessage) Dim rsWords strSQL = "SELECT * FROM " & Table_Prefix & "badwords;" Set rsWords = adoCon.Execute(strSQL) Do While NOT rsWords.EOF strMessage = Replace(strMessage, rsWords("badword"), rsWords("goodword"), 1, -1, 1) rsWords.MoveNext Loop rsWords.Close : Set rsWords = Nothing BadWords = strMessage End Function Function LongWords(strMessage) Dim ArrayMessageWord ' array contente le parole del messaggio Dim WordLoopCounter ' counter Dim LengthWord ' lunghezza delle parole contenute nell'array ArrayMessageWord = Split(Trim(strMessage), " ") LongWords = True For WordLoopCounter = 0 To UBound(ArrayMessageWord) LengthWord = Len(ArrayMessageWord(WordLoopCounter)) If Mid(ArrayMessageWord(WordLoopCounter),1,7) <> "http://" And Mid(ArrayMessageWord(WordLoopCounter),1,4) <> "www." Then If LengthWord => 50 Then LongWords = False End If End If Next End Function Function HighLight(txtSearch,txt) Dim txtEvid, l, r, txtTemp, txtExtracted, len_txt, len_txtSearch txtEvid = "" & txtSearch & "" len_txt = Len(txt) len_txtSearch = Len(txtSearch) l=1 r=1 HighLight = "" txtTemp = "" Do While l < len_txt+1 txtExtracted = Mid(txt,l,len_txtSearch) If UCase(txtExtracted) = UCase(txtSearch) Then txtBefore = Mid(txt, r, l-r) r = l + len_txtSearch txtTemp = txtBefore & txtEvid HighLight = HighLight & txtTemp End If l=l+1 Loop HighLight = HighLight & Right(txt,len_txt-r+1) If HighLight = "" Then HighLight = txt End Function Function Emoticon(ByVal strMessage) strMessage = Replace(strMessage, "[:)]", "", 1, -1, 1) strMessage = Replace(strMessage, "[;)]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:0]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:D]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:approve:]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:(]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:o)]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:oops:]", "", 1, -1, 1) strMessage = Replace(strMessage, "[xx(]", "", 1, -1, 1) strMessage = Replace(strMessage, "[}:)]", "", 1, -1, 1) strMessage = Replace(strMessage, "[8D]", "", 1, -1, 1) strMessage = Replace(strMessage, "[|)]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:strano:]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:yeah:]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:kiss:]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:?:]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:p]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:tuttook:]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:haha:]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:clap:]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:eek:]", "", 1, -1, 1) strMessage = Replace(strMessage, "[:cool:]", "", 1, -1, 1) Emoticon = strMessage End Function Function ReverseEmoticon(ByVal strMessage) strMessage = Replace(strMessage, "", "[:)]", 1, -1, 1) strMessage = Replace(strMessage, "", "[;)]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:0]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:D]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:approve:]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:(]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:o)]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:oops:]", 1, -1, 1) strMessage = Replace(strMessage, "", "[xx(]", 1, -1, 1) strMessage = Replace(strMessage, "", "[}:)]", 1, -1, 1) strMessage = Replace(strMessage, "", "[8D]", 1, -1, 1) strMessage = Replace(strMessage, "", "[|)]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:strano:]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:yeah:]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:kiss:]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:?:]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:p]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:tuttook:]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:haha:]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:clap:]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:eek:]", 1, -1, 1) strMessage = Replace(strMessage, "", "[:cool:]", 1, -1, 1) ReverseEmoticon = strMessage End Function Function Anteprima(sText, nParole) Dim nTemp, nVolte sText = Replace(sText, vbCrLf, "") nTemp = InStr(sText, " ") If nTemp <> 0 Then nVolte = 1 While nTemp <> 0 And nVolte < nParole nVolte = nVolte + 1 nTemp = InStr(nTemp + 1, sText, " ") Wend End If If nVolte > 0 Then If nTemp > 0 Then Anteprima = Mid(sText, 1, nTemp - 1) & " ..." Else Anteprima = sText End If Else If Len(sText) > 0 Then Anteprima = sText Else Anteprima = "" End If End If End Function '******************************************************************************************** %> <% '***************************************************************************** '*** REMOVE NOT ALLOWED TAGS - VALIDATE XHTML - REMOVE HTML ***** '***************************************************************************** Function removeAllTags(ByVal strInputEntry) strInputEntry = Replace(strInputEntry, "&", "&", 1, -1, 1) strInputEntry = Replace(strInputEntry, "<", "<", 1, -1, 1) strInputEntry = Replace(strInputEntry, ">", ">", 1, -1, 1) strInputEntry = Replace(strInputEntry, "#", "#", 1, -1, 1) strInputEntry = Replace(strInputEntry, "%", "%", 1, -1, 1) strInputEntry = Replace(strInputEntry, "*", "*", 1, -1, 1) strInputEntry = Replace(strInputEntry, "\", "\", 1, -1, 1) strInputEntry = Replace(strInputEntry, "'", "’", 1, -1, 1) strInputEntry = Replace(strInputEntry, """", """, 1, -1, 1) removeAllTags = strInputEntry End Function Function removemaligno(ByVal strInput) strInput = Replace(strInput, "&", "&", 1, -1, 1) strInput = Replace(strInput, "#", "#", 1, -1, 1) strInput = Replace(strInput, "%", "%", 1, -1, 1) strInput = Replace(strInput, "*", "*", 1, -1, 1) strInput = Replace(strInput, "\", "\", 1, -1, 1) strInput = Replace(strInput, "'", "’", 1, -1, 1) removemaligno = strInput End Function Function ValidateHTML(ByVal strInputEntry) strInputEntry = Replace(strInputEntry, "#", "#", 1, -1, 1) strInputEntry = Replace(strInputEntry, "%", "%", 1, -1, 1) strInputEntry = Replace(strInputEntry, "*", "*", 1, -1, 1) strInputEntry = Replace(strInputEntry, "\", "\", 1, -1, 1) strInputEntry = Replace(strInputEntry, "’", "'", 1, -1, 1) strInputEntry = Replace(strInputEntry, "€", "€", 1, -1, 0) ValidateHTML = strInputEntry End Function Function ValidateTEXT(ByVal strInputEntry) strInputEntry = Replace(strInputEntry, "&", "&", 1, -1, 1) strInputEntry = Replace(strInputEntry, "<", "<", 1, -1, 1) strInputEntry = Replace(strInputEntry, ">", ">", 1, -1, 1) strInputEntry = Replace(strInputEntry, "#", "#", 1, -1, 1) strInputEntry = Replace(strInputEntry, "%", "%", 1, -1, 1) strInputEntry = Replace(strInputEntry, "*", "*", 1, -1, 1) strInputEntry = Replace(strInputEntry, "\", "\", 1, -1, 1) strInputEntry = Replace(strInputEntry, "’", "'", 1, -1, 1) strInputEntry = Replace(strInputEntry, """, """", 1, -1, 1) ValidateTEXT = strInputEntry End Function Function RemoveHTML(strText) Dim nPos1 Dim nPos2 nPos1 = InStr(strText, "<") Do While nPos1 > 0 nPos2 = InStr(nPos1 + 1, strText, ">") If nPos2 > 0 Then strText = Left(strText, nPos1 - 1) & Mid(strText, nPos2 + 1) Else Exit Do End If nPos1 = InStr(strText, "<") Loop RemoveHTML = strText End Function '***************************************************************************** %> <% '********************************* '*** FormatDate Function ***** '********************************* Function FormatDateToDb(strdate) Dim strdateformatdb strdateformatdb = Year(strdate) & "-" & LeadingZero(Month(strdate)) & "-" & LeadingZero(Day(strdate)) & " " & LeadingZero(Hour(strdate)) & ":" & LeadingZero(Minute(strdate)) & ":" & LeadingZero(Second(strdate)) FormatDateToDb = strdateformatdb End Function Function LeadingZero(StrValue) If Len(StrValue) < 2 Then StrValue = "0" & StrValue LeadingZero = StrValue End Function Function WithoutZero(StrValue) If Mid(StrValue,1,1) = "0" Then StrValue = Right(StrValue,1) WithoutZero = StrValue End Function Function NameFromMonth(iMonth) Select Case CInt(iMonth) Case 1 s = strLangJan Case 2 s = strLangFeb Case 3 s = strLangMar Case 4 s = strLangApr Case 5 s = strLangMay Case 6 s = strLangJun Case 7 s = strLangJul Case 8 s = strLangAug Case 9 s = strLangSep Case 10 s = strLangOct Case 11 s = strLangNov Case 12 s = strLangDec End Select NameFromMonth = s End Function Function NameFromDay(iDayLight) Select Case CInt(iDayLight) Case 1 dl = strLangSun Case 2 dl = strLangMon Case 3 dl = strLangTue Case 4 dl = strLangWed Case 5 dl = strLangThu Case 6 dl = strLangFri Case 7 dl = strLangSat End Select NameFromDay = dl End Function Function FormatHour12(iHour) If iHour > 12 Then FormatHour12 = iHour - 12 Else FormatHour12 = iHour End If End Function Function AntePost(iHour,iMinute,iSecond) If iHour > 12 Or (iHour = 12 And iMinute >= 00 And iSecond >= 01) Then AntePost = "pm" Else AntePost = "am" End If End Function Function Suffix(iDayLight) Suffix = "th" If iDayLight = 1 Then Suffix = "st" If iDayLight = 2 Then Suffix = "nd" If iDayLight = 3 Then Suffix = "rd" End Function Function DoGMT(strDate) Dim nd, nd2, ArrayGmtValue, IntegerValue, DecimalValue nd = DateAdd("s", offsetServer,Now()) nd2 = DateDiff("s", nd, strDate) ' hour format nd2 = FormatNumber(nd2/3600,2) nd2 = Replace(nd2,",",":") nd2 = Replace(nd2,".",":") ArrayGmtValue = Split(nd2, ":") IntegerValue = ArrayGmtValue(LBound(ArrayGmtValue)) DecimalValue = ArrayGmtValue(UBound(ArrayGmtValue)) If LeadingZero(IntegerValue) = "00" And LeadingZero(DecimalValue) = "00" Then IntegerValue = " GMT" DecimalValue = "" Else If InStr(IntegerValue,"-") <> 0 Then IntegerValue = Replace(IntegerValue,"-","") IntegerValue = " -" & LeadingZero(IntegerValue) Else IntegerValue = " +" & LeadingZero(IntegerValue) End If If DecimalValue <> "00" Then DecimalValue = (DecimalValue/100) * 60 End If nd2 = IntegerValue & DecimalValue DoGMT = nd2 End Function Function DoW3C(strDate) Dim nd, nd2, ArrayGmtValue, IntegerValue, DecimalValue, blnUTC blnUTC = False nd = DateAdd("s", offsetServer,Now()) nd2 = DateDiff("s", nd, strDate) ' hour format nd2 = FormatNumber(nd2/3600,2) nd2 = Replace(nd2,",",":") nd2 = Replace(nd2,".",":") ArrayGmtValue = Split(nd2, ":") IntegerValue = ArrayGmtValue(LBound(ArrayGmtValue)) DecimalValue = ArrayGmtValue(UBound(ArrayGmtValue)) If LeadingZero(IntegerValue) = "00" And LeadingZero(DecimalValue) = "00" Then blnUTC = True IntegerValue = "Z" DecimalValue = "" Else If InStr(IntegerValue,"-") <> 0 Then IntegerValue = Replace(IntegerValue,"-","") IntegerValue = "-" & LeadingZero(IntegerValue) Else IntegerValue = "+" & LeadingZero(IntegerValue) End If If DecimalValue <> "00" Then DecimalValue = (DecimalValue/100) * 60 End If If blnUTC = False Then nd2 = IntegerValue & ":" & DecimalValue Else nd2 = IntegerValue & DecimalValue End If DoW3C = nd2 End Function Function FormatDateView(ByVal pStrDate,strdate) Dim strdateformat Dim lLngSecond Dim lLngMinute Dim lLngHour Dim lLngDay Dim lLngWeekDay Dim lLngMonth Dim lLngYear strdateformat = DateAdd("s",Time_difference,strdate) lLngSecond = Second(strdateformat) lLngMinute = Minute(strdateformat) lLngHour = Hour(strdateformat) lLngDay = Day(strdateformat) lLngWeekDay = WeekDay(strdateformat) lLngMonth = Month(strdateformat) lLngYear = Year(strdateformat) pStrDate = Replace(pStrDate,"%a",LCase(AntePost(lLngHour,LeadingZero(lLngMinute),LeadingZero(lLngSecond))), 1, -1, 0) ' Lowercase Ante meridiem and Post meridiem: i.e.am or pm pStrDate = Replace(pStrDate,"%A",UCase(AntePost(lLngHour,LeadingZero(lLngMinute),LeadingZero(lLngSecond))), 1, -1, 0) ' Uppercase Ante meridiem and Post meridiem: i.e.AM or PM pStrDate = Replace(pStrDate,"%d",LeadingZero(lLngDay), 1, -1, 0) ' Day of the month, 2 digits with leading zeroes: i.e. 01 to 31 pStrDate = Replace(pStrDate,"%D",Left(NameFromDay(lLngWeekDay),3), 1, -1, 0) ' A textual representation of a weekday, three letters: i.e. Sun pStrDate = Replace(pStrDate,"%F",NameFromMonth(lLngMonth), 1, -1, 0) ' A full textual representation of a month: i.e. January pStrDate = Replace(pStrDate,"%g",WithoutZero(FormatHour12(lLngHour)), 1, -1, 0) ' 12-hour format without leading zeroes: i.e. 1 to 12 pStrDate = Replace(pStrDate,"%G",WithoutZero(lLngHour), 1, -1, 0) ' 24-hour format without leading zeroes: i.e. 0 to 23 pStrDate = Replace(pStrDate,"%h",LeadingZero(FormatHour12(lLngHour)), 1, -1, 0) ' 12-hour format with leading zeroes: i.e. 01 to 12 pStrDate = Replace(pStrDate,"%H",LeadingZero(lLngHour), 1, -1, 0) ' 24-hour format of an hour with leading zeroes: i.e. 00 to 23 pStrDate = Replace(pStrDate,"%i",LeadingZero(lLngMinute), 1, -1, 0) ' Minutes with leading zeroes: i.e. 00 to 59 pStrDate = Replace(pStrDate,"%j",WithoutZero(lLngDay), 1, -1, 0) ' Day of the month without leading zeroes: i.e. 1 to 31 pStrDate = Replace(pStrDate,"%l",NameFromDay(lLngWeekDay), 1, -1, 0) ' A full textual representation of the day of the week: i.e Sunday pStrDate = Replace(pStrDate,"%m",LeadingZero(lLngMonth), 1, -1, 0) ' Numeric representation of a month, with leading zeroes: i.e. 01 to 12 pStrDate = Replace(pStrDate,"%M",Left(NameFromMonth(lLngMonth),3), 1, -1, 0) ' A short textual representation of a month, three letters : i.e. Jan pStrDate = Replace(pStrDate,"%n",WithoutZero(lLngMonth), 1, -1, 0) ' Numeric representation of a month, without leading zeroes: i.e. 1 to 12 pStrDate = Replace(pStrDate,"%O",DoGMT(DateAdd("s",Time_difference,Now())), 1, -1, 0) ' Difference to Greenwich time (GMT) in hours: i.e. +2:00 pStrDate = Replace(pStrDate,"%r",Left(NameFromDay(lLngWeekDay),3) & ", " & _ LeadingZero(lLngDay) & " " & Left(NameFromMonth(lLngMonth),3) & " " & lLngYear & " " & LeadingZero(lLngHour) & _ ":" & LeadingZero(lLngMinute) & ":" & LeadingZero(lLngSecond) & DoGMT(DateAdd("s",Time_difference,Now())), 1, -1, 0)' RFC 822 formatted date: Thu, 21 Dec 2000 16:01:07 GMT+2:00 pStrDate = Replace(pStrDate,"%s",LeadingZero(lLngSecond), 1, -1, 0) ' Seconds, with leading zeroes: i.e 00 to 59 pStrDate = Replace(pStrDate,"%S",Suffix(lLngDay), 1, -1, 0) ' English ordinal suffix for the day of the month, 2 characters: i.e. "st", "nd", "rd" or "th" pStrDate = Replace(pStrDate,"%Y",lLngYear, 1, -1, 0) ' A full numeric representation of a year, 4 digits: i.e. 1999 or 2004 pStrDate = Replace(pStrDate,"%y",Right(lLngYear,2), 1, -1, 0) ' A two digit representation of a year: i.e. 99 or 04 pStrDate = Replace(pStrDate,"%W",lLngYear & "-" & LeadingZero(lLngMonth) & "-" & LeadingZero(lLngDay) & "T" & LeadingZero(lLngHour) & ":" & LeadingZero(lLngMinute) & _ ":" & LeadingZero(lLngSecond) & DoW3C(DateAdd("s",Time_difference,Now())), 1, -1, 0)' W3C Date and Time Format ( ISO 8601 ): 1994-11-05T08:15:30-05:00 FormatDateView = pStrDate End Function '********************************* %> <% '********************************** '*** Send Email Function ****** '********************************** Function InviaEmail(CorpoEmail, IndirizzoEmailFrom, IndirizzoEmailTo, OggettoEmail, BCCEmail) Dim objCDOSYSMail Dim objCDOMail Dim objJMail Dim objAspEmail Dim objAspMail Select Case strEmailComponent Case "CDOSYS" Dim objCDOSYSCon Set objCDOSYSMail = Server.CreateObject("CDO.Message") Set objCDOSYSCon = Server.CreateObject ("CDO.Configuration") With objCDOSYSCon .Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer If Not IsBlank(UblogSMTPUsername) And Not IsBlank(UblogSMTPPassword) Then .Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 ' cdoBasic ; cdoNTLM = 2 (NTLM) .Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = UblogSMTPUsername .Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = UblogSMTPPassword End If .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 .Fields.Update End With Set objCDOSYSMail.Configuration = objCDOSYSCon With objCDOSYSMail .From = ValidateHTML(Ublogname) & "<" & IndirizzoEmailFrom & ">" .To = "<" & IndirizzoEmailTo & ">" If Not IsBlank(BCCEmail) Then .Bcc = BCCEmail .Subject = OggettoEmail If Ublog_Email_Format = "HTML" Then .HTMLBody = CorpoEmail Else .TextBody = CorpoEmail End If If Not IsBlank(strSmtpServer) Then .Send End With Set objCDOSYSMail = Nothing Set objCDOSYSCon = Nothing Case "CDONTS" Set objCDOMail = Server.CreateObject("CDONTS.NewMail") With objCDOMail .From = ValidateHTML(Ublogname) & "<" & IndirizzoEmailFrom & ">" .To = "<" & IndirizzoEmailTo & ">" If Not IsBlank(BCCEmail) Then .Bcc = BCCEmail .Subject = OggettoEmail .Body = CorpoEmail If Ublog_Email_Format = "HTML" Then .BodyFormat = 0 Else .BodyFormat = 1 End If .MailFormat = 0 .Importance = 1 .Send End With Set objCDOMail = Nothing Case "JMAIL" Set objJMail = Server.CreateObject("JMail.SMTPMail") With objJMail .ServerAddress = strSmtpServer If Not IsBlank(UblogSMTPUsername) And Not IsBlank(UblogSMTPPassword) Then .MailServerUserName = UblogSMTPUsername .MailServerPassword = UblogSMTPPassword End If .Sender = IndirizzoEmailFrom .SenderName = ValidateHTML(Ublogname) .AddRecipient IndirizzoEmailTo If Not IsBlank(BCCEmail) Then .AddRecipientBcc BCCEmail .Subject = OggettoEmail If Ublog_Email_Format = "HTML" Then .HTMLBody = CorpoEmail Else .Body = CorpoEmail End If .Priority = 3 If Not IsBlank(strSmtpServer) Then .Execute End With Set objJMail = Nothing Case "ASPEMAIL" Set objAspEmail = Server.CreateObject("Persits.MailSender") With objAspEmail .Host = strSmtpServer If Not IsBlank(UblogSMTPUsername) And Not IsBlank(UblogSMTPPassword) Then .Username = UblogSMTPUsername .Password = UblogSMTPPassword End If .From = IndirizzoEmailFrom .FromName = ValidateHTML(Ublogname) .AddAddress IndirizzoEmailTo If Not IsBlank(BCCEmail) Then .AddBcc BCCEmail .Subject = OggettoEmail If Ublog_Email_Format = "HTML" Then .IsHTML = True .Body = CorpoEmail If Not IsBlank(strSmtpServer) Then .Send End With Set objAspEmail = Nothing Case "ASPMAIL" Set objAspMail = Server.CreateObject("SMTPsvg.Mailer") With objAspMail .RemoteHost = strSmtpServer .FromAddress = IndirizzoEmailFrom .FromName = ValidateHTML(Ublogname) .AddRecipient " ", IndirizzoEmailTo If Not IsBlank(BCCEmail) Then .AddBCC BCCEmail .Subject = OggettoEmail If Ublog_Email_Format = "HTML" Then .ContentType = "text/html" .BodyText = CorpoEmail If Not IsBlank(strSmtpServer) Then .SendMail End With Set objAspMail = Nothing End Select InviaEmail = True End Function '********************************** %> <% Sub AccessOK() If bLoggedIn Then sWelcome = strRegLoginWelcome & "" & UCase(Session(Cookie_Name & "UblogUsername")) & "    " If Session(Cookie_Name & "UblogLevel") = 2 Or Session(Cookie_Name & "UblogLevel") = 3 Then sWelcome = sWelcome & "" & strLangSelectAdminSection & "  |  " End If sWelcome = sWelcome & "Logout   " Else sWelcome = strRegLoginWelcomeGuest & "    " sWelcome = sWelcome & "Login  |  " sWelcome = sWelcome & "" & strRegRegister & "  |  " sWelcome = sWelcome & "" & strRegRecupera & "   " End If Response.Write sWelcome End Sub '*********** USER ONLINE ************* Sub LogActiveUser Dim strActiveUserList Dim intUserStart, intUserEnd Dim strUser Dim strDate strActiveUserList = Application("ActiveUserList") If Instr(1, strActiveUserList, Session.SessionID) > 0 Then Application.Lock intUserStart = Instr(1, strActiveUserList, Session.SessionID) intUserEnd = Instr(intUserStart, strActiveUserList, "|") strUser = Mid(strActiveUserList, intUserStart, intUserEnd - intUserStart) strActiveUserList = Replace(strActiveUserList, strUser, Session.SessionID & ":" & Now()) Application("ActiveUserList") = strActiveUserList Application.UnLock Else Application.Lock Application("ActiveUsers") = CInt(Application("ActiveUsers")) + 1 Application("ActiveUserList") = Application("ActiveUserList") & Session.SessionID & ":" & Now() & "|" Application.UnLock End If End Sub Sub ActiveUserCleanup Dim ix Dim intUsers Dim strActiveUserList Dim aActiveUsers Dim intActiveUserCleanupTime Dim intActiveUserTimeout intActiveUserCleanupTime = 1 'In minutes, how often should the ActiveUserList be cleaned up. intActiveUserTimeout = 20 'In minutes, how long before a User is considered Inactive and is deleted from ActiveUserList If Application("ActiveUserList") = "" Then Exit Sub If DateDiff("n", Application("ActiveUsersLastCleanup"), Now()) > intActiveUserCleanupTime Then Application.Lock Application("ActiveUsersLastCleanup") = Now() Application.Unlock intUsers = 0 strActiveUserList = Application("ActiveUserList") strActiveUserList = Left(strActiveUserList, Len(strActiveUserList) - 1) aActiveUsers = Split(strActiveUserList, "|") For ix = 0 To UBound(aActiveUsers) If DateDiff("n", Mid(aActiveUsers(ix), Instr(1, aActiveUsers(ix), ":") + 1, Len(aActiveUsers(ix))), Now()) > intActiveUserTimeout Then aActiveUsers(ix) = "XXXX" Else intUsers = intUsers + 1 End If Next strActiveUserList = Join(aActiveUsers, "|") & "|" strActiveUserList = Replace(strActiveUserList, "XXXX|", "") Application.Lock Application("ActiveUserList") = strActiveUserList Application("ActiveUsers") = intUsers Application.UnLock End If End Sub %> <% '************************** '*** Box Subroutine ***** '************************** '************** HOME ************** Sub Home() Set Homefso = Server.CreateObject("Scripting.FileSystemObject") If Homefso.FileExists(Server.MapPath(root_box_folder & "/" & "Home.inc")) Then Set Hometxt = Homefso.OpenTextFile(Server.MapPath(root_box_folder & "/" & "Home.inc"),1) Do While Not Hometxt.AtEndOfStream Response.Write Hometxt.ReadLine Loop Hometxt.Close Set Hometxt = Nothing End If Set Homefso = Nothing Response.Write("

    ") End Sub '************** ARCHIVE ************** Sub Archive() %>
    <% = UCase(strLangSelectArchivesBlog) %>
     
    RSS ATOM  <% = strLangSelectArchives %>
     
    <% = strLangCurrentMonth %>



    <% End Sub %> <% '************** CATEGORY ************** Sub Category() %>
    <% = UCase(strLangSelectCategoryBlog) %>
     
    <% Set rs_cat = Server.CreateObject("ADODB.Recordset") strSQL = "SELECT " & Table_Prefix & "category.cat_id,cat_name,cat_parent,cat_des,COUNT(" & Table_Prefix & "blog.blog_id) "_ & "AS cat_count FROM " & Table_Prefix & "category LEFT JOIN " & Table_Prefix & "blog2cat ON (" & Table_Prefix & "category.cat_id = " & Table_Prefix & "blog2cat.cat_id) "_ & "LEFT JOIN " & Table_Prefix & "blog ON (" & Table_Prefix & "blog.blog_id = " & Table_Prefix & "blog2cat.blog_id) WHERE cat_parent = 0 " _ & "GROUP BY " & Table_Prefix & "category.cat_id,cat_name,cat_parent,cat_des ORDER BY cat_name;" rs_cat.Open strSQL, strCon, 1, 3 While Not rs_cat.Eof %>
    <% If ci = rs_cat("cat_id") And rs_cat("cat_count") <> 0 Then %> <% = ValidateHTML(rs_cat("cat_name")) %> [ <% = rs_cat("cat_count") %> ] <% ElseIf rs_cat("cat_count") = 0 Then %> <% = ValidateHTML(rs_cat("cat_name")) %> [ <% = rs_cat("cat_count") %> ] <% Else Response.Write " "" Then Response.Write ValidateHTML(rs_cat("cat_des")) Else Response.Write strLangALTCategoryListView & ValidateHTML(rs_cat("cat_name")) End If Response.Write """>" & ValidateHTML(rs_cat("cat_name")) & " [ " & rs_cat("cat_count") & " ]" End If %>  " target="_blank" title="<% = strLangSelectCategoryBlog %> - RSS 2.0 Feed" class="rssButton">RSS " target="_blank" title="<% = strLangSelectCategoryBlog %> - ATOM 0.3 Feed" class="atomButton">ATOM
    <% ListCat rs_cat("cat_id"), 0, "CategoryViewList" rs_cat.movenext Wend rs_cat.Close Set rs_cat = Nothing %>


    <% End Sub %> <% '************** POLL ************** Sub Poll() %>
    <% = UCase(strLangSelectPoll) %>
     
    <% Dim blnAlreadyVoted Dim TotalVotes Dim rs_poll Dim VotePercent blnAlreadyVoted = False TotalVotes = 0 Set rs_poll = Server.CreateObject("ADODB.Recordset") strSQL = "SELECT * FROM " & Table_Prefix & "polls ORDER BY " & Table_Prefix & "polls.id DESC LIMIT 1;" rs_poll.CursorType = 2 rs_poll.LockType = 3 rs_poll.Open strSQL, strCon If rs_poll.EOF Then Response.Write "

    " & strLangErrorMessageNoPolls & "
    " Else For k = 1 To 7 TotalVotes = TotalVotes + CInt(rs_poll("Votes_" & k & "")) Next If CInt(Request.Cookies(Cookie_Name & "Ublog")("PollId")) = CInt(rs_poll("id")) Then blnAlreadyVoted = True %>
    <% For i = 1 To 7 If NOT rs_poll("Choice_" & i) = "" Then If blnAlreadyVoted = False Then Response.Write "" Else If TotalVotes = 0 Then VotePercent = FormatPercent(0, 0) Else VotePercent = FormatPercent((rs_poll("Votes_" & i) / TotalVotes), 0) End If Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" End If End If Next %>
    <% = rs_poll("Question") %>
     
    " Response.Write " " & rs_poll("Choice_" & i) & "
    " & rs_poll("Choice_" & i) & "
    " & VotePercent & "
    <% If blnAlreadyVoted = False Then %> " /> <% Else Response.Write strLangGlobPollTotalVote & " : " & TotalVotes & "" End If %>
     
    ','poll','toolbar=0,location=0,status=0,menubar=0,scrollbars=1,resizable=0,width=400,height=330,top=0,left=0')"><% = strLangGlobPollViewResult %>
    <% End If %>


    <% rs_poll.Close : Set rs_poll = Nothing End Sub %> <% '************** SEARCH ************** Sub Search() %>
    <% = UCase(strLangSelectSearchBlog) %>
     


    <% End Sub %> <% '************** RECENT ENTRIES ************** Sub Recent() %>
    <% = UCase(strLangSelectRecentBlog) %>
     
    <% Dim rs_blog_entries, Top Top = 8 strSQL = "SELECT blog_titolo,blog_id FROM " & Table_Prefix & "blog ORDER BY blog_id DESC LIMIT " & Top & ";" Set rs_blog_entries = adoCon.Execute(strSQL) If rs_blog_entries.EOF Then Response.Write "

    " & strLangErrorMessageNoBlog3 & "
    " Else While Not rs_blog_entries.eof %> <% rs_blog_entries.movenext Wend rs_blog_entries.Close Set rs_blog_entries = Nothing %>
     
    RSS ATOM <% End If %>


    <% End Sub %> <% '************** WEBCAM ************** Sub Webcam() %>
    <% = UCase(strLangSelectWebcam) %>
     
    <% Dim WebcamF, WebcamFs, ImageLastModify, ValueReal, SecondToday, SecondLast, SecondDiff Set WebcamFs = Server.CreateObject("Scripting.FileSystemObject") If WebcamFs.FileExists(Server.MapPath("images/webcamlive.jpg")) Then Set WebcamF = WebcamFs.GetFile(Server.MapPath("images/webcamlive.jpg")) ImageLastModify = WebcamF.DateLastModified End If Set WebcamFs = Nothing ValueReal = (Ublog_Web_Refresh/1000) + 50 SecondToday = DatePart("s",Now()) + (DatePart("n",Now())*60) SecondLast = DatePart("s",ImageLastModify) + (DatePart("n",ImageLastModify)*60) SecondDiff = Abs(SecondToday - SecondLast) If FormatDateTime(Now(),2) = FormatDateTime(ImageLastModify,2) And DatePart("h",Now()) = DatePart("h",ImageLastModify) Then If SecondDiff > ValueReal Then Response.Write("") Else Response.Write("") Response.Write("") End If Else Response.Write("") End If %>


    <% End Sub %> <% '************** BLOGGERS ************** Sub Bloggers() %>
    <% = UCase(strLangSelectBloggersBlog) %>
     
    <% Set rs_blogger = Server.CreateObject("ADODB.Recordset") strSQL = "SELECT id,username,COUNT(" & Table_Prefix & "blog.blog_id) "_ & "AS userblog_count FROM " & Table_Prefix & "users LEFT JOIN " & Table_Prefix & "blog ON " & Table_Prefix & "users.username = " & Table_Prefix & "blog.blog_autore "_ & "GROUP BY id,username ORDER BY username;" rs_blogger.Open strSQL, strCon, 1, 3 While Not rs_blogger.Eof %>
    <% If ui = rs_blogger("username") And rs_blogger("userblog_count") <> 0 Then %> <% = ValidateHTML(rs_blogger("username")) %> [ <% = rs_blogger("userblog_count") %> ] <% ElseIf rs_blogger("userblog_count") = 0 Then %> <% = ValidateHTML(rs_blogger("username")) %> [ <% = rs_blogger("userblog_count") %> ] <% Else %> &s=bloggers"><% = ValidateHTML(rs_blogger("username")) %> [ <% = rs_blogger("userblog_count") %> ] <% End If %>  " target="_blank" title="blogger <% = ValidateHTML(rs_blogger("username")) %> - RSS 2.0 Feed" class="rssButton">RSS " target="_blank" title="blogger <% = ValidateHTML(rs_blogger("username")) %> - ATOM 0.3 Feed" class="atomButton">ATOM
    <% rs_blogger.MoveNext Wend rs_blogger.Close : Set rs_blogger = Nothing %>


    <% End Sub %> <% '************** LATEST COMMENTS ************** Sub LatestComments() %>
    <% = UCase(strLangGetLatestComments) %>
     
    <% Dim rs_comments, Topc Topc = 10 strSQL = "SELECT commento_id,commento_autore," & Table_Prefix & "commenti.data,blog_titolo," & Table_Prefix & "blog.blog_id " _ & "FROM " & Table_Prefix & "commenti LEFT JOIN " & Table_Prefix & "blog ON " & Table_Prefix & "commenti.blog_id = " & Table_Prefix & "blog.blog_id "_ & "GROUP BY commento_id,commento_autore," & Table_Prefix & "commenti.data,blog_titolo," & Table_Prefix & "blog.blog_id ORDER BY " & Table_Prefix & "commenti.data DESC LIMIT " & Topc & ";" Set rs_comments = adoCon.Execute(strSQL) If rs_comments.EOF Then Response.Write "

    " & strLangErrorMessageNoLatestComments & "
    " Else While Not rs_comments.eof %> <% rs_comments.MoveNext Wend rs_comments.Close : Set rs_comments = Nothing End If %>
     


    <% End Sub %> <% '************** TOP COMMENTERS ************** Sub TopCommenters() %>
    <% = UCase(strLangGetTopCommenters) %>
     
    <% Dim rs_regular, Topr Topr = 10 Set rs_regular = Server.CreateObject("ADODB.Recordset") strSQL = "SELECT commento_autore,COUNT(commento_id) "_ & "AS commentsvis_count FROM " & Table_Prefix & "commenti "_ & "GROUP BY commento_autore ORDER BY commentsvis_count DESC LIMIT " & Topr & ";" Set rs_regular = adoCon.Execute(strSQL) If rs_regular.EOF Then Response.Write "

    " & strLangErrorMessageNoTopCommenters & "
    " Else While Not rs_regular.Eof %>
    <% = ValidateHTML(rs_regular("commento_autore")) %>  [ <% = rs_regular("commentsvis_count") %> ]
    <% rs_regular.MoveNext Wend rs_regular.Close : Set rs_regular = Nothing End If %>


    <% End Sub %> <% '************** COUNTER ************** Sub Counter() %>
    <% = UCase(strLangSelectCounter) %>
     
    <% Set objFile = CreateObject("Scripting.FileSystemObject") Set filestream = objFile.OpenTextFile(Server.MapPath(folder_upload & "/counter.txt"), 1, true) visite = filestream.ReadLine() filestream.Close if Session("visiting")<>1 then Session("visiting") = 1 visite = visite + 1 end if Set filestream = objFile.CreateTextFile(Server.MapPath(folder_upload & "/counter.txt"), true) filestream.WriteLine(visite) filestream.Close Set filestream = Nothing Set objFile = Nothing Response.Write( strLangSelectCounterVisitor & "    " & visite & "
    ") %> <% Call LogActiveUser() Call ActiveUserCleanup() Response.Write strLangSelectCounterOnline & " " & Application("ActiveUsers") & "" %>
     



    <% End Sub '***************************** %> <% Response.ContentType = "text/xml; charset=" & strLangSelectCharset & "" %> <% Response.Write "" %> <% Ublogname = RemoveHTML(Ublogname) Ublogname = ValidateHTML(Ublogname) Ublog_Meta_Des = RemoveHTML(Ublog_Meta_Des) Ublog_Meta_Des = ValidateHTML(Ublog_Meta_Des) %> <% = Ublogname %> <% = Ublog_address %> <% = Ublog_Meta_Des %> <% = Left(Ubloglanguage,2) %> Copyright 2004-2007 <% = emailamministratore %> <% = emailamministratore %> <% = UblogReloadVersion %> http://blogs.law.harvard.edu/tech/rss <% Dim rsblog, blog_testo, blog_author, blog_title, action, rscats, ArrCat, iCount, sLine action = Request.QueryString("action") Select Case action Case "category" strSQL = "SELECT * FROM " & Table_Prefix & "blog LEFT JOIN " & Table_Prefix & "blog2cat ON " & Table_Prefix & "blog.blog_id = " & Table_Prefix & "blog2cat.blog_id " _ & "WHERE " & Table_Prefix & "blog2cat.cat_id = " & CInt(Request.QueryString("ci")) & " ORDER BY data DESC;" Case "recent" strSQL = "SELECT * FROM " & Table_Prefix & "blog ORDER BY data DESC LIMIT " & CInt(Request.QueryString("top")) & ";" Case "bloggers" strSQL = "SELECT * FROM " & Table_Prefix & "blog WHERE blog_autore = '" & Request.QueryString("ui") & "' ORDER BY data DESC;" Case Else strSQL = "SELECT * FROM " & Table_Prefix & "blog ORDER BY data DESC;" End Select Set rsblog = adoCon.Execute(strSQL) While Not rsblog.Eof blog_testo = ValidateHTML(rsblog("blog_testo")) blog_author = ValidateHTML(rsblog("blog_autore")) blog_title = ValidateHTML(rsblog("blog_titolo")) strSQL = "SELECT " & Table_Prefix & "category.cat_id,cat_name FROM " & Table_Prefix & "category, " & Table_Prefix & "blog2cat " _ & "WHERE " & Table_Prefix & "category.cat_id = " & Table_Prefix & "blog2cat.cat_id AND " & Table_Prefix & "blog2cat.blog_id = " & CLng(rsblog("blog_id")) & " " _ & "ORDER BY cat_name;" Set rscats = adoCon.Execute(strSQL) ArrCat = rscats.GetRows() rscats.Close : Set rscats = Nothing %> <![CDATA[<% = blog_title %>]]> <% = Ublog_address %>blog_comment.asp?bi=<% = rsblog("blog_id") %> ]]> <% If rsblog("blog_email") <> "" Then %> ]]> <% End If %> <% Response.Write " UBound(ArrCat, 2) Then Response.Write " , " Next Response.Write "]]>" %> <% = FormatDateView("%r",rsblog("data")) %> <% = Ublog_address %>blog_comment.asp?bi=<% = rsblog("blog_id") %> <% rsblog.MoveNext Wend rsblog.Close : Set rsblog = Nothing Set strCon = Nothing Set adoCon = Nothing %>